home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
DCAL.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
6KB
|
157 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, VAttr%)
DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%)
DECLARE SUB Month0 (MonthName$, NameLen%, MonthNumber%)
SUB DCal (Scrn%(), CalDate$)
CalcAttr 5, 0, FrameAttr% ' outer frame
CalcAttr 5, 1, GridAttr% ' grid
CalcAttr 11, 5, MonthNameAttr% ' month and year
CalcAttr 1, 7, DayNameAttr% ' days of the week
CalcAttr 5, 1, EdgeDayAttr% ' days in previous and next months
CalcAttr 15, 1, WeekdayAttr% ' weekdays
CalcAttr 7, 1, WeekendAttr% ' weekends
CalcAttr 14, 1, TodayAttr% ' today, if showing current month
L% = LBOUND(Scrn%)
' --------------- draw the outer frame ----------------------------------------
St$ = "┌──────────────────────────────────┐"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 5, 43, FrameAttr%
St$ = "├──────────────────────────────────┤"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 8, 43, FrameAttr%
St$ = "└──────────────────────────────────┘"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 22, 43, FrameAttr%
Row% = 6
St$ = "│ │"
DO
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 43, FrameAttr%
IF Row% = 7 THEN
Row% = 9
ELSE
Row% = Row% + 1
END IF
LOOP UNTIL Row% > 21
' --------------- fill in the header info -------------------------------------
IF LEN(CalDate$) >= 8 THEN
MonthNr% = VAL(CalDate$)
YearNr% = VAL(MID$(CalDate$, 7))
ELSE
St$ = DATE$
MonthNr% = VAL(St$)
YearNr% = VAL(MID$(St$, 7))
END IF
IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
IF MonthNr% = CINT(VAL(DATE$)) AND YearNr% = CINT(VAL(MID$(DATE$, 7))) THEN
CurrentMonth% = -1
Today% = CINT(VAL(MID$(DATE$, 4)))
END IF
MonthName$ = SPACE$(9)
Month0 MonthName$, MLen%, MonthNr%
MonthName$ = LEFT$(MonthName$, MLen%)
St$ = SPACE$(34)
MID$(St$, 17 - (LEN(MonthName$) + 6) \ 2) = MonthName$ + STR$(YearNr%)
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 6, 44, MonthNameAttr%
St$ = " Su Mo Tu We Th Fr Sa "
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 7, 44, DayNameAttr%
' --------------- draw the grid -----------------------------------------------
St$ = "────┬────┬────┬────┬────┬────┬────"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 9, 44, GridAttr%
FOR Row% = 10 TO 18 STEP 2
St$ = " │ │ │ │ │ │ "
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 44, GridAttr%
St$ = "────┼────┼────┼────┼────┼────┼────"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row% + 1, 44, GridAttr%
NEXT
St$ = " │ │ │ │ │ │ "
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 20, 44, GridAttr%
St$ = "────┴────┴────┴────┴────┴────┴────"
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 21, 44, GridAttr%
' --------------- calculate necessary info ------------------------------------
DateA2R MonthNr%, 1, YearNr%, RelDate&
IF MonthNr% = 12 THEN
DateA2R 1, 1, YearNr% + 1, NextDate&
ELSE
DateA2R MonthNr% + 1, 1, YearNr%, NextDate&
END IF
DaysInMonth% = NextDate& - RelDate&
DateR2A M%, DaysLastMonth%, Y%, RelDate& - 1&
' --------------- do the calendar ---------------------------------------------
WDay% = 0
DayNr% = DaysLastMonth% - RelDate& MOD 7& + 1
R% = 0: C% = 0
WHILE DayNr% <= DaysLastMonth%
St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
Row% = R% * 2 + 10
Col% = C% * 5 + 44
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
DayNr% = DayNr% + 1
WDay% = (WDay% + 1) MOD 7
IF WDay% THEN
C% = C% + 1
ELSE
R% = R% + 1
C% = 0
END IF
WEND
DayNr% = 1
WHILE DayNr% <= DaysInMonth%
St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
Row% = R% * 2 + 10
Col% = C% * 5 + 44
IF CurrentMonth% AND (DayNr% = Today%) THEN
VAttr% = TodayAttr%
ELSEIF WDay% = 0 OR WDay% = 6 THEN
VAttr% = WeekendAttr%
ELSE
VAttr% = WeekdayAttr%
END IF
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, VAttr%
DayNr% = DayNr% + 1
WDay% = (WDay% + 1) MOD 7
IF WDay% THEN
C% = C% + 1
ELSE
R% = R% + 1
C% = 0
END IF
WEND
DayNr% = 1
WHILE R% <= 5 AND C% <= 6
St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
Row% = R% * 2 + 10
Col% = C% * 5 + 44
DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
DayNr% = DayNr% + 1
WDay% = (WDay% + 1) MOD 7
IF WDay% THEN
C% = C% + 1
ELSE
R% = R% + 1
C% = 0
END IF
WEND
END SUB